NUSmodAn

• Notes:
  1. AY2017/2018 Semester 2, AY2018/2019 Semester 2, bidding data not available.
  2. The bidding statistics are highly non-normal, likely due to being bounded by zero (they cannot bid negative points or have negative bidders). May consider using zero-inflated or poisson regression if considering these statistics as dependent variables.

1 Phase 1: Setting Up Environment, Packages And Loading Data.

View Code/Details

1.1 >Packages And Options

• Load packages.

library(semTools)
library(ggplot2)
library(rjson)
library(stringr)
library(DT)
library(psych)
library(corrplot)
library(dplyr)
options(width = 999)
knitr::opts_chunk$set(dpi = 300, out.width = "50%", eval = TRUE)

1.2 >>Bidding Data From nusmods

• Extract data from nusmods API at https://nusmods.com/api/.
• CORS bidding data.

# load bidding data
# calculate loading times
before <- Sys.time()
# read data directly from URL
myjson <- fromJSON(file = url("https://api.nusmods.com/corsBiddingStatsRaw.json"))
# create empty dataframe which will act as a container to be populated with data
myBid <- data.frame()
# for each element in the myjson list, append it to myBid
for(r in 1:length(myjson))
{
  if(myjson[[r]]$Semester == 1 | myjson[[r]]$Semester == 2)
  {
    myBid <- rbind(myBid, myjson[[r]])
  }
  myjson[[r]] <- NA
}
# calculate loading time
after <- Sys.time()
after - before

# save
saveRDS(myBid, file = "myBid.RDS")

1.3 >>Load myBid.RDS

myBid <- readRDS("mydata.RDS")

1.4 >Module Information

# create empty dataframe which will act as a container to be populated with data
myModInfo <- data.frame()
# looping through each year
for(year in c(2011:2018))
{
  for(semester in c(1,2))
  {
    # create the url where data is to be extracted from
    myurl <- paste0("https://api.nusmods.com/", year, "-", year + 1, "/", semester, "/moduleTimetableDeltaRaw.json")
    myjson <- fromJSON(file = url(myurl))
    
    # for each element in the myjson list, append it to myModInfo
    for(r in 1:length(myjson))
    {
      if(isTRUE(str_detect(myjson[[r]]$ModuleCode, "^PL")))
      {
        if(myjson[[r]]$Semester == 1 | myjson[[r]]$Semester == 2)
        {
          myModInfo <- rbind(myModInfo, myjson[[r]])
        }
      }
      myjson[[r]] <- NA
    }
    cat(year, "Semester", semester, "Done!")
  }
}

# save
saveRDS(myModInfo, file = "myModInfo.RDS")

1.5 >>Load myModInfo.RDS

myModInfo <- readRDS("myModInfo.RDS")

2 Phase 2: Filter, Transform And Merge Data

View Code/Details

2.1 >myModInfo

• Filter Module Information, myModInfo.
  • Removing non-Psychology modules.
  • Removing tutorial information.
  • Removing duplicated rows.

2.1.1 >>Filter

# only keep the Psychology modules information
myModInfo <- subset(myModInfo,
                    str_detect(myModInfo$ModuleCode, "^PL"))

# remove information about tutorials
myModInfo <- subset(myModInfo,
                    myModInfo$LessonType != "TUTORIAL")

# only keep these columns
myModInfo <- myModInfo[,grep("ModuleCode|DayText|StartTime|Semester|AcadYear", names(myModInfo))]
# remove duplicated rows based on columns of ModuleCode, Acadyear, Semester, StartTime and DayText
myModInfo <- distinct(myModInfo, 
                      ModuleCode, AcadYear, Semester, StartTime, DayText)

2.2 >myBid

• Filter CORS Bidding Information, myBid.
  • Removing non-Psychology modules, including Roots and Wings (PLS) and Psychology for non-Psychology students (PLB).
  • Removing information from reserved modules.

2.2.1 >>Filter

# remove non-psychology modules
myBid <- subset(myBid,
                # only keep rows where module code begins with PL
                str_detect(myBid$ModuleCode, "^PL"))

# also remove Roots and Wings (PLS8001) and psychology for non-psych students (PLB1201)
myBid <- subset(myBid,
                !str_detect(myBid$ModuleCode, "PLS|PLB"))

# remove the rounds where it was reserved
myBid <- subset(myBid,
                !str_detect(myBid$StudentAcctType, "Reserved"))

# remove unneeded columns
myBid <- myBid[, -grep("Group|Faculty", names(myBid))]

2.3 >>Transform And Merge

• Transform
  • Created a new variable Level that denotes whether the module is Level 1, 2, 3 or 4.
  • Created a new variable BpQ that represents Bids per Quota, which is the number of bidders for each available quota of the module, derived from Bidders and Quota. Used as a measure of the popularity of a module, Higher BpQ signifies greater popularity.
  • Created a new variable LessonTime that denotes whether the lecture begins in the morning (before 12pm), in the afternoon (12pm to 4pm), in the evening (after 4pm).
• Merge
  • Add the information from myModInfo to myBid.

# create new column that indicates the level of the module, based on their module code
myBid$Level <- ifelse(str_detect(myBid$ModuleCode, "1[0-9][0-9][0-9]"), "Level 1",
                      ifelse(str_detect(myBid$ModuleCode, "2[0-9][0-9][0-9]"), "Level 2",
                             ifelse(str_detect(myBid$ModuleCode, "3[0-9][0-9][0-9]"), "Level 3",
                                    ifelse(str_detect(myBid$ModuleCode, "4[0-9][0-9][0-9]"), "Level 4", 
                                           "Graduate Module"))))
# crosstabs to doublecheck
# xtabs( ~ ModuleCode + Level, 
#        data = myBid, subset = NULL)

# create new column Bids Per Quota (BpQ)
myBid$BpQ <- as.numeric(myBid$Bidders)/as.numeric(myBid$Quota)

# create new column Bids Per Quota (BpQ)
myModInfo$LessonTime <- ifelse(as.numeric(myModInfo$StartTime) < 1200, "Morning",
                               ifelse(as.numeric(myModInfo$StartTime) > 1600, "Evening",
                                      "Afternoon"))

# note: there is only module information from AY2016/17 onwards
# all data before that period will be dropped
mydata <- merge(x = myBid, 
                y = myModInfo,
                by = c("ModuleCode", "AcadYear", "Semester"))

2.4 >Coercing Columns To Factors/Numeric

# transform these columns to numeric
for(r in c("Quota", "Bidders", "LowestBid", "LowestSuccessfulBid", "HighestBid", "StartTime"))
{
  mydata[,grep(r, names(mydata))] <- as.numeric(mydata[,grep(r, names(mydata))])
}
# transform these columns to factors
for(r in c("AcadYear", "Semester", "ModuleCode", "Round", "Level", "StudentAcctType", "DayText", "LessonTime"))
{
  mydata[,grep(r, names(mydata))] <- factor(mydata[,grep(r, names(mydata))])
}

2.5 >Vectors Of Column Names

# create vector of the column names which are factors
facnames <- names(select_if(mydata, is.factor))
# factor names without ModuleCode and StudentAcctType
facnames.mod <- facnames[-grep("ModuleCode|StudentAcctType", facnames)]
# create vector of the column names which are numeric
numnames <- names(select_if(mydata, is.numeric))
# numeric names without StartTime
numnames.time <- names(select_if(mydata, is.numeric))[-grep("StartTime", numnames)]

2.6 >Rearranging DayText Levels

mydata$DayText <- factor(mydata$DayText,
                         levels = c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday"))

2.7 >Rearranging LessonTime Levels

mydata$LessonTime <- factor(mydata$LessonTime,
                            levels = c("Morning", "Afternoon", "Evening"))

3 Phase 3: Data Diagnostics

• Plot univariate histograms and bivariate plots using loops for almost every combination of variables.
• The graphs from this section are predominantly for diagnostics rather than exploration, what I mean is that the graphs from this section would make little sense if one tried to draw insights from them. This is because they are aggregated across all other variables.
  • For example: The mean of Bidders is calculated across all academic years, all bidding rounds, all modules…
• What I am looking out for in this section are odd patterns, like zeroes in places where they shouldn’t be, missing data, highly non-normal data, variables with outliers, etc…

3.1 Univariate Descriptive Statistics

describe(mydata)

summary(mydata)

##    ModuleCode        AcadYear   Semester Round        Quota           Bidders        LowestBid       LowestSuccessfulBid   HighestBid                                        StudentAcctType     Level           BpQ             StartTime         DayText        LessonTime  
##  PL1101E: 324   2013/2014:493   1:1449   1A:634   Min.   :  1.00   Min.   :  0.0   Min.   :   0.00   Min.   :   0.0      Min.   :   0.0   New Students [P]                           : 314   Level 1: 324   Min.   : 0.00000   Min.   : 800   Monday   :479   Morning  : 723  
##  PL3232 : 124   2015/2016:485   2:1380   1B:389   1st Qu.:  4.00   1st Qu.:  1.0   1st Qu.:   1.00   1st Qu.:   1.0      1st Qu.:   1.0   NUS Students [G]                           : 141   Level 2: 169   1st Qu.: 0.02326   1st Qu.:1100   Tuesday  :588   Afternoon:1834  
##  PL3236 : 112   2014/2015:439            1C:273   Median : 15.00   Median :  3.0   Median :   1.00   Median :   1.0      Median : 400.0   NUS Students [P, G]                        : 327   Level 3:1520   Median : 0.33333   Median :1300   Wednesday:688   Evening  : 272  
##  PL3234 : 110   2016/2017:366            2A:410   Mean   : 25.95   Mean   : 13.2   Mean   :  70.16   Mean   : 258.7      Mean   : 732.7   NUS Students [P]                           : 331   Level 4: 816   Mean   : 1.05331   Mean   :1305   Thursday :684                   
##  PL3235 : 109   2012/2013:350            2B:463   3rd Qu.: 32.00   3rd Qu.: 10.0   3rd Qu.:   8.00   3rd Qu.: 271.0      3rd Qu.:1237.0   Returning Students [P]                     :1191                  3rd Qu.: 1.30000   3rd Qu.:1500   Friday   :390                   
##  PL3233 : 107   2011/2012:242            3A:366   Max.   :430.00   Max.   :440.0   Max.   :2430.00   Max.   :3459.0      Max.   :4801.0   Returning Students [P] and NUS Students [G]: 155                  Max.   :18.00000   Max.   :1900                                   
##  (Other):1943   (Other)  :454            3B:294                                                                                           Returning Students and New Students [P]    : 370

3.2 Univariate Histograms

View Histograms

# plot the categorical variables
# note: I did not include ModuleCode in this exploratory graph because it has too many levels (83)
for(r in facnames.mod)
{
  cat(paste0("Histogram Of ", r))
  
  plot(
    ggplot(data = mydata, aes_string(x = r, fill = r)) + 
      geom_histogram(stat = "count") + 
      ylab("Count") +
      ggtitle(paste0("Count of ", r)) +
      theme_classic() + 
      theme(axis.text.x = element_text(angle = 90, size = 6, vjust = -0.3),
            axis.title.x = element_blank())
  )
}

## Histogram Of AcadYear

## Histogram Of Semester

## Histogram Of Round

## Histogram Of Level

## Histogram Of DayText

## Histogram Of LessonTime

# plot the continuous variables
for(r in numnames)
{
  cat(paste0("Histogram Of ", r))
  
  plot(
    ggplot(data = mydata, aes_string(x = r, fill = r)) + 
      geom_histogram(bins = 90, fill = "violetred") + 
      ylab("Histogram") +
      ggtitle(paste0("Frequency of ", r)) +
      theme_classic() + 
      theme(axis.text.x = element_text(angle = 90, size = 6, vjust = -0.3),
            axis.title.x = element_text())
  )
}

## Histogram Of Quota

## Histogram Of Bidders

## Histogram Of LowestBid

## Histogram Of LowestSuccessfulBid

## Histogram Of HighestBid

## Histogram Of BpQ

## Histogram Of StartTime

3.3 Bivariate Plots

View Categorical-Categorical Heatmaps

3.3.1 Categorical-Categorical

# create vector to loop across
for(r in 1:length(facnames.mod))
{
  for(i in 1:length(facnames.mod))
  {
    # dont do anything if they are the same or the graph has been made before
    if(i == r | i < r)
    {
    } else {
      cat(paste0(facnames.mod[r]," ~ ",facnames.mod[i]))
      
      # create formula for xtabs
      tempform <- paste0("~ ", facnames.mod[r], " + ", facnames.mod[i])
      # temp is a dataframe that is only going to exist in this section
      # and overwritten with each loop
      temp <- as.data.frame(xtabs(eval(parse(text = tempform)),
                                  data = mydata,
                                  subset = NULL))
      plot(
        ggplot(data = temp, aes_string(x = facnames.mod[r], y = facnames.mod[i], fill = "Freq", label = "Freq")) +
          geom_tile() + 
          geom_text() + 
          scale_fill_gradient(low = "white", high = "violetred") + 
          theme_minimal() + 
          theme(axis.text.x = element_text(angle = 90, vjust = -0.3),
                legend.position = "none")
      )
    }
  }
}

## AcadYear ~ Semester

## AcadYear ~ Round

## AcadYear ~ Level

## AcadYear ~ DayText

## AcadYear ~ LessonTime

## Semester ~ Round

## Semester ~ Level

## Semester ~ DayText

## Semester ~ LessonTime

## Round ~ Level

## Round ~ DayText

## Round ~ LessonTime

## Level ~ DayText

## Level ~ LessonTime

## DayText ~ LessonTime

View Continuous-Continuous Scatterplots

3.3.2 Continuous-Continuous

for(r in 1:length(numnames))
{
  for(i in 1:length(numnames))
  {
    # dont do anything if they are the same or the graph has been made before
    if(i == r | i < r)
    {
    } else {
      cat(paste0(numnames[r]," ~ ",numnames[i]))
      # create formula for lm()
      tempform.std <- paste0("scale(", numnames[i],")", " ~ ", "scale(", numnames[r], ")")
      tempform <- paste0(numnames[i], " ~ ", numnames[r])
      # regress to get best fit line
      # standardized
      stdreg <- lm(eval(parse(text = tempform.std)),
                   data = mydata)
      # unstandardized
      reg <- lm(eval(parse(text = tempform)),
                data = mydata)
      
      plot(
        ggplot(data = mydata, aes_string(x = numnames[r], y = numnames[i])) +
          geom_point(color = "violetred", size = 2, alpha = 0.3) +
          theme_classic() + 
          geom_abline(slope = reg$coefficients[2], intercept = reg$coefficients[1], lty = "dashed") + 
          geom_label(aes(x = Inf, y = Inf, label = paste0("Standardized Regression Coefficient = ",
                                                          round(stdreg$coefficients[2],3)),
                         hjust = 1, vjust = 2)) + 
          theme(axis.text.x = element_text(angle = 90, vjust = -0.3))
      )
    }
  }
}

## Quota ~ Bidders

## Quota ~ LowestBid

## Quota ~ LowestSuccessfulBid

## Quota ~ HighestBid

## Quota ~ BpQ

## Quota ~ StartTime

## Bidders ~ LowestBid

## Bidders ~ LowestSuccessfulBid

## Bidders ~ HighestBid

## Bidders ~ BpQ

## Bidders ~ StartTime

## LowestBid ~ LowestSuccessfulBid

## LowestBid ~ HighestBid

## LowestBid ~ BpQ

## LowestBid ~ StartTime

## LowestSuccessfulBid ~ HighestBid

## LowestSuccessfulBid ~ BpQ

## LowestSuccessfulBid ~ StartTime

## HighestBid ~ BpQ

## HighestBid ~ StartTime

## BpQ ~ StartTime

View Continuous-Continuous Correlation Matrix

3.3.3 Correlation Matrix

corrplot.mixed(cor(mydata[,grep(paste0(numnames.time, collapse = "|"), names(mydata))]),
               upper = "color",
               tl.pos = "lt",
               tl.cex = 0.5,
               cl.cex = 0.5)

3.3.4 Continuous-Categorical

View Continuous-Categorical Boxplots

for(r in facnames.mod)
{
  for(i in numnames)
  {
    cat(paste0(r," ~ ",i))
    # graph
    plot(
      ggplot(data = mydata, aes_string(x = r, y = i, fill = r)) + 
        geom_boxplot() + 
        theme_classic() + 
        theme(legend.position = "none",
              axis.text.x = element_text(angle = 90, vjust = -0.3))
    )
  }
}

## AcadYear ~ Quota

## AcadYear ~ Bidders

## AcadYear ~ LowestBid

## AcadYear ~ LowestSuccessfulBid

## AcadYear ~ HighestBid

## AcadYear ~ BpQ

## AcadYear ~ StartTime

## Semester ~ Quota

## Semester ~ Bidders

## Semester ~ LowestBid

## Semester ~ LowestSuccessfulBid

## Semester ~ HighestBid

## Semester ~ BpQ

## Semester ~ StartTime

## Round ~ Quota

## Round ~ Bidders

## Round ~ LowestBid

## Round ~ LowestSuccessfulBid

## Round ~ HighestBid

## Round ~ BpQ

## Round ~ StartTime

## Level ~ Quota

## Level ~ Bidders

## Level ~ LowestBid

## Level ~ LowestSuccessfulBid

## Level ~ HighestBid

## Level ~ BpQ

## Level ~ StartTime

## DayText ~ Quota

## DayText ~ Bidders

## DayText ~ LowestBid

## DayText ~ LowestSuccessfulBid

## DayText ~ HighestBid

## DayText ~ BpQ

## DayText ~ StartTime

## LessonTime ~ Quota

## LessonTime ~ Bidders

## LessonTime ~ LowestBid

## LessonTime ~ LowestSuccessfulBid

## LessonTime ~ HighestBid

## LessonTime ~ BpQ

## LessonTime ~ StartTime